home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
forth
/
amiga
/
amigaker.arc
/
15.structs
< prev
next >
Wrap
Text File
|
1987-12-30
|
8KB
|
251 lines
;
; 15.structures.
;
;
* ?condition (s f -- ) Compile time checking.
dc.w -1
dc.l link3
link3 set *-4
dc.b $8A,'?conditio',$80!'n'
cnop 0,2
_question_condition
dc.l nest
dc.l _not,_nest_abort_quote
dc.b 19,'Conditionals Wrong',0
cnop 0,2
dc.l _exit
* >mark (s -- addr ) Set up for forward branch.
dc.w -1
dc.l link2
link2 set *-4
dc.b $85,'>mar',$80!'k'
cnop 0,2
_to_mark dc.l nest
dc.l _here,_0,_comma,_exit
* >resolve (s addr -- ) Resolve a forward branch.
dc.w -1
dc.l link2
link2 set *-4
dc.b $88,'>resolv',$80!'e'
cnop 0,2
_to_resolve dc.l nest
dc.l _here,_swap,_store,_exit
* <mark (s -- addr ) Set up for a Backward branch.
dc.w -1
dc.l link0
link0 set *-4
dc.b $85,'<mar',$80!'k'
cnop 0,2
_from_mark dc.l nest
dc.l _here,_exit
* <resolve (s addr -- ) Resolve a Backward branch.
dc.w -1
dc.l link0
link0 set *-4
dc.b $88,'<resolv',$80!'e'
cnop 0,2
_from_resolve dc.l nest
dc.l _comma,_exit
;following routines are the same as the above, but use error checking.
* ?>mark (s -- f addr )
dc.w -1
dc.l link3
link3 set *-4
dc.b $86,'?>mar',$80!'k'
cnop 0,2
_question_to_mark dc.l nest
dc.l _true,_to_mark,_exit
* ?>resolve (s f addr -- )
dc.w -1
dc.l link3
link3 set *-4
dc.b $89,'?>resolv',$80!'e'
cnop 0,2
_question_to_resolve
dc.l nest
dc.l _swap,_question_condition,_to_resolve
dc.l _exit
* ?<mark (s -- f addr )
dc.w -1
dc.l link3
link3 set *-4
dc.b $86,'?<mar',$80!'k'
cnop 0,2
_question_from_mark
dc.l nest
dc.l _true,_from_mark,_exit
* ?<resolve (s f addr -- )
dc.w -1
dc.l link3
link3 set *-4
dc.b $89,'?<resolv',$80!'e'
cnop 0,2
_question_from_resolve
dc.l nest
dc.l _swap,_question_condition
dc.l _from_resolve,_exit
* leave (s -- ) Compiles the runtime routine (leave).
dc.w -1
dc.l link0
link0 set *-4
dc.b $85!immediate,'leav',$80!'e'
cnop 0,2
_leave dc.l nest
dc.l _compile,_nest_leave,_exit
* ?leave (s -- ) Compiles the runtime routine (?leave)
dc.w -1
dc.l link3
link3 set *-4
dc.b $86!immediate,'?leav',$80!'e'
cnop 0,2
_question_leave dc.l nest
dc.l _compile,_nest_question_leave,_exit
; from here to the end of this file are looping and flow control.
* begin
; Used in: begin..while..repeat begin..until begin..again
dc.w -1
dc.l link2
link2 set *-4
dc.b $85!immediate,'begi',$80!'n'
cnop 0,2
_begin dc.l nest
dc.l _question_from_mark,_exit
* then
; Used in: if..then if..else..then
dc.w -1
dc.l link0
link0 set *-4
dc.b $84!immediate,'the',$80!'n'
cnop 0,2
_then dc.l nest
dc.l _question_to_resolve,_exit
* do (s limit start -- )
; Used in: do..loop do..+loop
dc.w -1
dc.l link0
link0 set *-4
dc.b $82!immediate,'d',$80!'o'
cnop 0,2
_do dc.l nest
dc.l _compile,_nest_do,_question_to_mark
dc.l _exit
* ?do (s limit start -- )
; Used in: ?do..loop ?do..+loop
dc.w -1
dc.l link3
link3 set *-4
dc.b $83!immediate,'?d',$80!'o'
cnop 0,2
_question_do dc.l nest
dc.l _compile,_nest_question_do
dc.l _question_to_mark,_exit
* loop
; Used in: do..loop ?do..loop
dc.w -1
dc.l link0
link0 set *-4
dc.b $84!immediate,'loo',$80!'p'
cnop 0,2
_loop dc.l nest
dc.l _compile,_nest_loop,_2dup
dc.l _4_plus,_question_from_resolve
dc.l _question_to_resolve,_exit
* +loop (s n -- )
; Used in: do..+loop ?do..+loop
dc.w -1
dc.l link3
link3 set *-4
dc.b $85!immediate,'+loo',$80!'p'
cnop 0,2
_plus_loop dc.l nest
dc.l _compile,_nest_plus_loop,_2dup
dc.l _4_plus,_question_from_resolve
dc.l _question_to_resolve,_exit
* until (s f -- )
; Used in: begin..until
dc.w -1
dc.l link1
link1 set *-4
dc.b $85!immediate,'unti',$80!'l'
cnop 0,2
_until dc.l nest
dc.l _compile,_question_branch
dc.l _question_from_resolve,_exit
* again
; Used in: begin..again
dc.w -1
dc.l link1
link1 set *-4
dc.b $85!immediate,'agai',$80!'n'
cnop 0,2
_again dc.l nest
dc.l _compile,_branch
dc.l _question_from_resolve,_exit
* repeat
; Used in: begin..while..repeat
dc.w -1
dc.l link2
link2 set *-4
dc.b $86!immediate,'repea',$80!'t'
cnop 0,2
_repeat dc.l nest
dc.l _2swap,_again,_then,_exit
* if (s fl -- )
; Used in: if..else..then
dc.w -1
dc.l link1
link1 set *-4
dc.b $82!immediate,'i',$80!'f'
cnop 0,2
_if dc.l nest
dc.l _compile,_question_branch
dc.l _question_to_mark,_exit
* else
; Used in: if..else..then
dc.w -1
dc.l link1
link1 set *-4
dc.b $84!immediate,'els',$80!'e'
cnop 0,2
_else dc.l nest
dc.l _compile,_branch
dc.l _question_to_mark,_2swap
dc.l _question_to_resolve,_exit
* while (s fl -- )
; Used in: begin..while..repeat
dc.w -1
dc.l link3
link3 set *-4
dc.b $85!immediate,'whil',$80!'e'
cnop 0,2
_while dc.l nest
dc.l _if,_exit